home *** CD-ROM | disk | FTP | other *** search
/ Clickx 115 / Clickx 115.iso / software / tools / windows / tails-i386-0.16.iso / live / filesystem.squashfs / usr / sbin / pam-auth-update < prev    next >
Encoding:
Text File  |  2011-10-17  |  18.9 KB  |  698 lines
  1. #!/usr/bin/perl -w
  2.  
  3. # pam-auth-update: update /etc/pam.d/common-* from /usr/share/pam-configs
  4. #
  5. # Update the /etc/pam.d/common-* files based on the per-package profiles
  6. # provided in /usr/share/pam-configs/ taking into consideration user's
  7. # preferences (as determined via debconf prompting).
  8. #
  9. # Written by Steve Langasek <steve.langasek@canonical.com>
  10. #
  11. # Copyright (C) 2008 Canonical Ltd.
  12. #
  13. # This program is free software; you can redistribute it and/or modify
  14. # it under the terms of version 3 of the GNU General Public License as
  15. # published by the Free Software Foundation.
  16. #
  17. # # This program is distributed in the hope that it will be useful,
  18. # but WITHOUT ANY WARRANTY; without even the implied warranty of
  19. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20. # GNU General Public License for more details.
  21. #
  22. # You should have received a copy of the GNU General Public License
  23. # along with this program; if not, write to the Free Software
  24. # Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301,
  25. # USA.
  26.  
  27. use strict;
  28. use Debconf::Client::ConfModule ':all';
  29. use IPC::Open2 'open2';
  30.  
  31. version('2.0');
  32. my $capb=capb('backup escape');
  33.  
  34. my $inputdir = '/usr/share/pam-configs';
  35. my $template = 'libpam-runtime/profiles';
  36. my $errtemplate = 'libpam-runtime/conflicts';
  37. my $overridetemplate = 'libpam-runtime/override';
  38. my $blanktemplate = 'libpam-runtime/no_profiles_chosen';
  39. my $confdir = '/etc/pam.d';
  40. my $savedir = '/var/lib/pam';
  41. my (%profiles, @sorted, @enabled, @conflicts, @new, %removals);
  42. my $force = 0;
  43. my $package = 0;
  44. my $priority = 'high';
  45. my %md5sums = (
  46.     'auth' => ['8d4fe17e66ba25de16a117035d1396aa'],
  47.     'account' => ['3c0c362eaf3421848b679d63fd48c3fa'],
  48.     'password' => [
  49.         '50fce2113dfda83ac8bdd5a6e706caec',
  50.         '4bd7610f2e85f8ddaef79c7db7cb49eb',
  51.         '9ba753d0824276b44bcadfee1f87b6bc',
  52.     ],
  53.     'session' => [
  54.         '240fb92986c885b327cdb21dd641da8c',
  55.         '4a25673e8b36f1805219027d3be02cd2',
  56.     ],
  57.     'session-noninteractive' => [
  58.         'ad2b78ce1498dd637ef36469430b6ac6',
  59.     ],
  60. );
  61.  
  62. opendir(DIR, $inputdir) || die "could not open config directory: $!";
  63. while (my $profile = readdir(DIR)) {
  64.     next if ($profile eq '.' || $profile eq '..');
  65.     %{$profiles{$profile}} = parse_pam_profile($inputdir . '/' . $profile);
  66. }
  67. closedir DIR;
  68.  
  69. # use a '--force' arg to specify that /etc/pam.d should be overwritten; 
  70. # used only on upgrades where the postinst has already determined that the
  71. # checksums match.  Module packages other than libpam-runtime itself must
  72. # NEVER use this option!  Document with big skullses and crossboneses!  It
  73. # needs to be exposed for libpam-runtime because that's the package that
  74. # decides whether we have a pristine config to be converted, and knows
  75. # whether the version being upgraded from is one for which the conversion
  76. # should be done.
  77.  
  78. while ($#ARGV >= 0) {
  79.     my $opt = shift;
  80.     if ($opt eq '--force') {
  81.         $force = 1;
  82.     } elsif ($opt eq '--package') {
  83.         $package = 1;
  84.     } elsif ($opt eq '--remove') {
  85.         while ($#ARGV >= 0) {
  86.             last if ($ARGV[0] =~ /^--/);
  87.             $removals{shift @ARGV} = 1;
  88.         }
  89.         # --remove implies --package
  90.         $package = 1 if (keys(%removals));
  91.     }
  92. }
  93.  
  94. $priority = 'medium' if ($package);
  95.  
  96. x_loadtemplatefile('/var/lib/dpkg/info/libpam-runtime.templates','libpam-runtime');
  97.  
  98. # always sort by priority, so we have consistency and don't have to
  99. # shuffle later
  100. @sorted = sort { $profiles{$b}->{'Priority'} <=> $profiles{$a}->{'Priority'}
  101.                  || $b cmp $a }
  102.                keys(%profiles);
  103. # If we're being called for package removal, filter out those options here
  104. @sorted = grep { !$removals{$_} } @sorted;
  105.  
  106. subst($template, 'profile_names', join(', ',@sorted));
  107. subst($template, 'profiles',
  108.     join(', ', map { $profiles{$_}->{'Name'} } @sorted));
  109.  
  110. my $diff = diff_profiles($confdir,$savedir);
  111.  
  112. if ($diff) {
  113.     @enabled = grep { !$removals{$_} } @{$diff->{'mods'}};
  114. } else {
  115.     @enabled = split(/, /,get($template));
  116. }
  117.  
  118. # find out what we've seen, so we can ignore those defaults
  119. my %seen;
  120. if (-e $savedir . '/seen') {
  121.     open(SEEN,$savedir . '/seen');
  122.     while (<SEEN>) {
  123.         chomp;
  124.         $seen{$_} = 1;
  125.     }
  126.     close(SEEN);
  127. }
  128.  
  129. # filter out any options that are no longer available for any reason
  130. @enabled = grep { $profiles{$_} } @enabled;
  131.  
  132. # an empty module set is an error, so in that case grab all the defaults
  133. if (!@enabled) {
  134.     %seen = ();
  135.     $priority = 'high' unless ($force);
  136. }
  137.  
  138. # add any previously-unseen configs
  139. push(@enabled,
  140.      grep { $profiles{$_}->{'Default'} eq 'yes' && !$seen{$_} } @sorted);
  141. @enabled = sort { $profiles{$b}->{'Priority'} <=> $profiles{$a}->{'Priority'}
  142.                   || $b cmp $a }
  143.                 @enabled;
  144. my $prev = '';
  145. @enabled = grep { $_ ne $prev && (($prev) = $_) } @enabled;
  146.  
  147. # Do we have any new options to show?  If not, we shouldn't reprompt the
  148. # user, at any priority level, unless explicitly called.
  149. @new = grep { !$seen{$_} } @sorted;
  150.  
  151. # if diff_profiles() fails, and we weren't passed a 'force' argument
  152. # (because this isn't an upgrade from an old version, or the checksum
  153. # didn't match, or we're being called by some other module package), prompt
  154. # the user whether to override.  If the user declines (the default), we
  155. # never again manage this config unless manually called with '--force'.
  156. if (!$diff && !$force) {
  157.     input('high',$overridetemplate);
  158.     go();
  159.     $force = 1 if (get($overridetemplate) eq 'true');
  160. }
  161.  
  162. if (!$diff && !$force) {
  163.     print STDERR <<EOF;
  164.  
  165. pam-auth-update: Local modifications to /etc/pam.d/common-*, not updating.
  166. pam-auth-update: Run pam-auth-update --force to override.
  167.  
  168. EOF
  169.     exit;
  170. }
  171.  
  172. umask(0022);
  173.  
  174. do {
  175.     @conflicts = ();
  176.  
  177.     if (@new || !$package) {
  178.         fset($template,'seen','false');
  179.     }
  180.     set($template,join(', ', @enabled));
  181.  
  182.     input($priority,$template);
  183.     go();
  184.  
  185.     @enabled = split(/, /, get($template));
  186.  
  187.     # in case of conflicts, automatically unset the lower priority
  188.     # item of each pair
  189.     foreach my $elem (@enabled)
  190.     {
  191.         for (my $i=$#enabled; $i >= 0; $i--)
  192.         {
  193.             my $conflict = $enabled[$i];
  194.             if ($profiles{$elem}->{'Conflicts'}->{$conflict}) {
  195.                 splice(@enabled,$i,1);
  196.                 my $desc = $profiles{$elem}->{'Name'}
  197.                     . ', ' . $profiles{$conflict}->{'Name'};
  198.                 push(@conflicts,$desc);
  199.             }
  200.         }
  201.     }
  202.     if (@conflicts) {
  203.         subst($errtemplate, 'conflicts', join("\\n", @conflicts));
  204.         input('high',$errtemplate);
  205.     }
  206.     set($template, join(', ', @enabled));
  207.     if (!@enabled) {
  208.         input('high',$blanktemplate);
  209.         # we can only end up here by user error, but give them another
  210.         # shot at selecting a correct config anyway.
  211.         fset($template,'seen','false');
  212.     }
  213. } while (@conflicts || !@enabled);
  214.  
  215. # the decision has been made about what configs to use, so even if
  216. # something fails after this, we shouldn't go munging the default
  217. # options again.  Save the list of known configs to /var/lib/pam.
  218. open(SEEN,"> $savedir/seen");
  219. for my $i (@sorted) {
  220.     print SEEN "$i\n";
  221. }
  222. close(SEEN);
  223.  
  224. # @enabled now contains our list of profiles to use for piecing together
  225. # a config
  226. # we have:
  227. # - templates into which we insert the specialness
  228. # - magic comments denoting the beginning and end of our managed block;
  229. #   looking at only the functional config lines would potentially let us
  230. #   handle more cases, at the expense of much greater complexity, so
  231. #   pass on this at least for the first round
  232. # - a representation of the autogenerated config stored in /var/lib/pam,
  233. #   that we can diff against in order to account for changed options or
  234. #   manually dropped modules
  235. # - a hash describing the local modifications the user has made to the
  236. #   config; these are always preserved unless manually overridden with
  237. #   the --force option
  238.  
  239. write_profiles(\%profiles, \@enabled, $confdir, $savedir, $diff, $force);
  240.  
  241.  
  242. # take a single line from a stock config, and merge it with the
  243. # information about local admin edits
  244. sub merge_one_line
  245. {
  246.     my ($line,$diff,$count) = @_;
  247.     my (@opts,$modline);
  248.  
  249.     my ($adds,$removes);
  250.  
  251.     $line =~ /^((\[[^]]+\]|\w+)\s+\S+)\s*(.*)/;
  252.  
  253.     @opts = split(/\s+/,$3);
  254.     $modline = $1;
  255.     $modline =~ s/end/$count/g;
  256.     if ($diff) {
  257.         my $mod = $modline;
  258.         $mod =~ s/(\[[^0-9]*)[0-9]+(.*\])/$1$2/g;
  259.         $adds = \%{$diff->{'add'}{$mod}};
  260.         $removes = \%{$diff->{'remove'}{$mod}};
  261.     } else {
  262.         $adds = $removes = undef;
  263.     }
  264.  
  265.     for (my $i = 0; $i <= $#opts; $i++) {
  266.         if ($adds->{$opts[$i]}) {
  267.             delete $adds->{$opts[$i]};
  268.         }
  269.         if ($removes->{$opts[$i]}) {
  270.             splice(@opts,$i,1);
  271.             $i--;
  272.         }
  273.     }
  274.     return $modline . " " . join(' ',@opts,sort keys(%{$adds})) . "\n";
  275. }
  276.  
  277. # return the lines for a given config name, type, and position in the stack
  278. sub lines_for_module_and_type
  279. {
  280.     my ($profiles, $mod, $type, $modpos) = @_;
  281.     if ($modpos == 0 && $profiles->{$mod}{$type . '-Initial'}) {
  282.         return $profiles->{$mod}{$type . '-Initial'};
  283.     }
  284.     return $profiles->{$mod}{$type};
  285. }
  286.  
  287. # create a single PAM config from the indicated template and selections,
  288. # writing to a new file
  289. sub create_from_template
  290. {
  291.     my($template,$dest,$profiles,$enabled,$diff,$type) = @_;
  292.     my $state = 0;
  293.     my $uctype = ucfirst($type);
  294.     $type =~ s/-noninteractive//;
  295.  
  296.     open(INPUT,$template) || return 0;
  297.     open(OUTPUT,">$dest") || return 0;
  298.  
  299.     while (<INPUT>) {
  300.         if ($state == 1) {
  301.             if (/^# here's the fallback if no module succeeds/) {
  302.                 print OUTPUT;
  303.                 $state++;
  304.             }
  305.             next;
  306.         }
  307.         if ($state == 3) {
  308.             if (/^# end of pam-auth-update config/) {
  309.                 print OUTPUT;
  310.                 $state++;
  311.             }
  312.             next;
  313.         }
  314.  
  315.         print OUTPUT;
  316.  
  317.         my ($pattern,$val);
  318.         if ($state == 0) {
  319.             $pattern = '^# here are the per-package modules \(the "Primary" block\)';
  320.             $val = 'Primary';
  321.         } elsif ($state == 2) {
  322.             $pattern = '^# and here are more per-package modules \(the "Additional" block\)';
  323.             $val = 'Additional';
  324.         } else {
  325.             next;
  326.         }
  327.  
  328.         if (/$pattern/) {
  329.             my $i = 0;
  330.             my $count = 0;
  331.             # first we need to get a count of lines that we're
  332.             # going to output, so we can fix up the jumps correctly
  333.             for my $mod (@{$enabled}) {
  334.                 my $output;
  335.                 next if (!$profiles->{$mod}{$uctype . '-Type'});
  336.                 next if $profiles->{$mod}{$uctype . '-Type'} ne $val;
  337.                 $output = lines_for_module_and_type($profiles, $mod, $uctype, $i++);
  338.                 # bypasses a perl warning about @_, sigh
  339.                 my @tmparr = split("\n+",$output);
  340.                 $count += @tmparr;
  341.             }
  342.  
  343.             # in case anything tries to jump in the 'additional'
  344.             # block, let's try not to jump off the stack...
  345.             $count-- if ($val eq 'Additional');
  346.  
  347.             # no primary block, so output a stock pam_permit line
  348.             # to keep the stack intact
  349.             if ($val eq 'Primary' && $count == 0)
  350.             {
  351.                 print OUTPUT "$type\t[default=1]\t\t\tpam_permit.so\n";
  352.             }
  353.  
  354.             $i = 0;
  355.             for my $mod (@{$enabled}) {
  356.                 my $output;
  357.                 my @output;
  358.                 next if (!$profiles->{$mod}{$uctype . '-Type'});
  359.                 next if $profiles->{$mod}{$uctype . '-Type'} ne $val;
  360.                 $output = lines_for_module_and_type($profiles, $mod, $uctype, $i++);
  361.                 for my $line (split("\n",$output)) {
  362.                     $line = merge_one_line($line,$diff,
  363.                                            $count);
  364.                     print OUTPUT "$type\t$line";
  365.                     $count--;
  366.                 }
  367.             }
  368.             $state++;
  369.         }
  370.     }
  371.     close(INPUT);
  372.     close(OUTPUT);
  373.  
  374.     if ($state < 4) {
  375.         unlink($dest);
  376.         return 0;
  377.     }
  378.     return 1;
  379. }
  380.  
  381. # take a template file, strip out everything between the markers, and
  382. # return the md5sum of the remaining contents.  Used for testing for
  383. # local modifications of the boilerplate.
  384. sub get_template_md5sum
  385. {
  386.     my($template) = @_;
  387.     my $state = 0;
  388.  
  389.     open(INPUT,$template) || return '';
  390.     my($md5sum_fd,$output_fd);
  391.     my $pid = open2($md5sum_fd, $output_fd, 'md5sum');
  392.     return '' if (!$pid);
  393.  
  394.     while (<INPUT>) {
  395.         if ($state == 1) {
  396.             if (/^# here's the fallback if no module succeeds/) {
  397.                 print $output_fd $_;
  398.                 $state++;
  399.             }
  400.             next;
  401.         }
  402.         if ($state == 3) {
  403.             if (/^# end of pam-auth-update config/) {
  404.                 print $output_fd $_;
  405.                 $state++;
  406.             }
  407.             next;
  408.         }
  409.  
  410.         print $output_fd $_;
  411.  
  412.         my ($pattern,$val);
  413.         if ($state == 0) {
  414.             $pattern = '^# here are the per-package modules \(the "Primary" block\)';
  415.         } elsif ($state == 2) {
  416.             $pattern = '^# and here are more per-package modules \(the "Additional" block\)';
  417.         } else {
  418.             next;
  419.         }
  420.  
  421.         if (/$pattern/) {
  422.             $state++;
  423.         }
  424.     }
  425.     close(INPUT);
  426.     close($output_fd);
  427.     my $md5sum = <$md5sum_fd>;
  428.     close($md5sum_fd);
  429.     waitpid $pid, 0;
  430.  
  431.     $md5sum = (split(/\s+/,$md5sum))[0];
  432.     return $md5sum;
  433. }
  434.  
  435. # merge a set of module declarations into a set of new config files,
  436. # using the information returned from diff_profiles().
  437. sub write_profiles
  438. {
  439.     my($profiles,$enabled,$confdir,$savedir,$diff,$force) = @_;
  440.  
  441.     if (! -d $savedir) {
  442.         mkdir($savedir);
  443.     }
  444.         
  445.     # because we can't atomically replace both /var/lib/pam/$foo and
  446.     # /etc/pam.d/common-$foo at the same time, take steps to make this
  447.     # somewhat robust
  448.     for my $type ('auth','account','password','session',
  449.                   'session-noninteractive')
  450.     {
  451.         my $target = $confdir . '/common-' . $type;
  452.         my $template = $target;
  453.         my $dest = $template . '.pam-new';
  454.  
  455.         my $diff = $diff;
  456.         if ($diff) {
  457.             $diff = \%{$diff->{$type}};
  458.         }
  459.  
  460.         # Detect if the template is unmodified, and if so, use
  461.         # the version from /usr/share.  Depends on knowing the
  462.         # md5sums of the originals.
  463.         my $md5sum = get_template_md5sum($template);
  464.         for my $i (@{$md5sums{$type}}) {
  465.             if ($md5sum eq $i) {
  466.                 $template = '/usr/share/pam/common-' . $type;
  467.                 last;
  468.             }
  469.         }
  470.  
  471.         # first, write out the new config
  472.         if (!create_from_template($template,$dest,$profiles,$enabled,
  473.                                   $diff,$type))
  474.         {
  475.             if (!$force) {
  476.                 return 0;
  477.             }
  478.             $template = '/usr/share/pam/common-' . $type;
  479.             if (!create_from_template($template,$dest,$profiles,
  480.                                       $enabled,$diff,$type))
  481.             {
  482.                 return 0;
  483.             }
  484.         }
  485.  
  486.         # then write out the saved config
  487.         if (!open(OUTPUT, "> $savedir/$type.new")) {
  488.             unlink($dest);
  489.             return 0;
  490.         }
  491.         my $i = 0;
  492.         my $uctype = ucfirst($type);
  493.         for my $mod (@{$enabled}) {
  494.             my $output;
  495.             next if (!$profiles->{$mod}{$uctype . '-Type'});
  496.             next if ($profiles->{$mod}{$uctype . '-Type'} eq 'Additional');
  497.  
  498.             $output = lines_for_module_and_type($profiles, $mod, $uctype, $i++);
  499.             if ($output) {
  500.                 print OUTPUT "Module: $mod\n";
  501.                 print OUTPUT $output . "\n";
  502.             }
  503.         }
  504.  
  505.         # no primary block, so output a stock pam_permit line
  506.         if ($i == 0)
  507.         {
  508.             print OUTPUT "Module: null\n";
  509.             print OUTPUT "[default=1]\t\t\tpam_permit.so\n";
  510.         }
  511.  
  512.         $i = 0;
  513.         for my $mod (@{$enabled}) {
  514.             my $output;
  515.             next if (!$profiles->{$mod}{$uctype . '-Type'});
  516.             next if ($profiles->{$mod}{$uctype . '-Type'} eq 'Primary');
  517.  
  518.             $output = lines_for_module_and_type($profiles, $mod, $uctype, $i++);
  519.             if ($output) {
  520.                 print OUTPUT "Module: $mod\n";
  521.                 print OUTPUT $output . "\n";
  522.             }
  523.         }
  524.  
  525.         close(OUTPUT);
  526.  
  527.         # then do the renames, back-to-back
  528.         # we have to use system because File::Copy is in
  529.         # perl-modules, not perl-base
  530.         if (-e "$target" && $force) {
  531.             system('cp','-f',$target,$target . '.pam-old');
  532.         }
  533.         rename($dest,$target);
  534.         rename("$savedir/$type.new","$savedir/$type");
  535.     }
  536.  
  537.     # at the end of a successful write, reset the 'seen' flag and the
  538.     # value of the debconf override question.
  539.     fset($overridetemplate,'seen','false');
  540.     set($overridetemplate,'false');
  541. }
  542.  
  543. # reconcile the current config in /etc/pam.d with the saved ones in
  544. # /var/lib/pam; returns a hash of profile names and the corresponding
  545. # options that should be added/removed relative to the stock config.
  546. # returns false if any of the markers are missing that permit a merge,
  547. # or on any other failure.
  548. sub diff_profiles
  549. {
  550.     my ($sourcedir,$savedir) = @_;
  551.     my (%diff);
  552.  
  553.     @{$diff{'mods'}} = ();
  554.     # Load the saved config from /var/lib/pam, then iterate through all
  555.     # lines in the current config that are in the managed block.
  556.     # If anything fails here, just return immediately since we then
  557.     # have nothing to merge; instead, the caller will decide later
  558.     # whether to force an overwrite.
  559.     for my $type ('auth','account','password','session',
  560.                   'session-noninteractive')
  561.     {
  562.         my (@saved,$modname);
  563.  
  564.         open(SAVED,$savedir . '/' . $type) || return 0;
  565.         while (<SAVED>) {
  566.             if (/^Module: (.*)/) {
  567.                 $modname = $1;
  568.                 next;
  569.             }
  570.             chomp;
  571.             # trim out the destination of any jumps; this saves
  572.             # us from having to re-parse everything just to fix
  573.             # up the jump lengths, when changes to these will
  574.             # already show up as inconsistencies elsewhere
  575.             s/(\[[^0-9]*)[0-9]+(.*\])/$1$2/g;
  576.             s/(\[.*)end(.*\])/$1$2/g;
  577.             my (@temp) = ($modname,$_);
  578.             push(@saved,\@temp);
  579.         }
  580.         close(SAVED);
  581.  
  582.         my $state = 0;
  583.         my (@prev_opts,$curmod);
  584.         my $realtype = $type;
  585.         $realtype =~ s/-noninteractive//;
  586.  
  587.         open(CURRENT,$sourcedir . '/common-' . $type) || return 0;
  588.         while (<CURRENT>) {
  589.             if ($state == 0) {
  590.                 $state = 1
  591.                    if (/^# here are the per-package modules \(the "Primary" block\)/);
  592.                 next;
  593.             }
  594.             if ($state == 1) {
  595.                 s/^$realtype\s+//;
  596.                 if (/^# here's the fallback if no module succeeds/) {
  597.                     $state = 2;
  598.                     next;
  599.                 }
  600.             }
  601.             if ($state == 2) {
  602.                 $state = 3
  603.                    if (/^# and here are more per-package modules \(the "Additional" block\)/);
  604.                 next;
  605.             }
  606.             if ($state == 3) {
  607.                 last if (/^# end of pam-auth-update config/);
  608.                 s/^$realtype\s+//;
  609.             }
  610.  
  611.             my $found = 0;
  612.             my $curopts;
  613.             while (!$found && $#saved >= 0) {
  614.                 my $line;
  615.                 ($modname,$line) = @{$saved[0]};
  616.                 shift(@saved);
  617.                 $line =~ /^((\[[^]]+\]|\w+)\s+\S+)\s*(.*)/;
  618.                 @prev_opts = split(/\s+/,$3);
  619.                 $curmod = $1;
  620.                 # FIXME: the key isn't derived from the config
  621.                 # name, so collisions are possible if more
  622.                 # than one config references the same module
  623.  
  624.                 $_ =~ s/(\[[^0-9]*)[0-9]+(.*\])/$1$2/g;
  625.                 # check if this is a match for the current line
  626.                 if ($_ =~ /^\Q$curmod\E\s*(.*)$/) {
  627.                     $found = 1;
  628.                     $curopts = $1;
  629.                     push(@{$diff{'mods'}},$modname);
  630.                 }
  631.             }
  632.  
  633.             # there's a line in the live config that doesn't
  634.             # correspond to anything from the saved config.
  635.             # treat this as a failure; it's very error-prone
  636.             # to decide what to do with an added line that
  637.             # didn't come from a package.
  638.             return 0 if (!$found);
  639.  
  640.             for my $opt (split(/\s+/,$curopts)) {
  641.                 my $found = 0;
  642.                 for (my $i = 0; $i <= $#prev_opts; $i++) {
  643.                     if ($prev_opts[$i] eq $opt) {
  644.                         $found = 1;
  645.                         splice(@prev_opts,$i,1);
  646.                     }
  647.                 }
  648.                 $diff{$type}{'add'}{$curmod}{$opt} = 1 if (!$found);
  649.             }
  650.             for my $opt (@prev_opts) {
  651.                 $diff{$type}{'remove'}{$curmod}{$opt} = 1;
  652.             }
  653.         }
  654.         close(CURRENT);
  655.  
  656.         # we couldn't parse the config, so the merge fails
  657.         return 0 if ($state < 3);
  658.     }
  659.     return \%diff;
  660. }
  661.  
  662. # simple function to parse a provided config file, in pseudo-RFC822
  663. # format,
  664. sub parse_pam_profile
  665. {
  666.     my ($profile) = $_[0];
  667.     my $fieldname;
  668.     my %profile;
  669.     open(PROFILE, $profile) || die "could not read profile $profile: $!";
  670.     while (<PROFILE>) {
  671.         if (/^(\S+):\s+(.*)$/) {
  672.             $fieldname = $1;
  673.             # compatibility with the first implementation round;
  674.             # "Auth-Final" is now just called "Auth"
  675.             $fieldname =~ s/-Final$//;
  676.             if ($fieldname eq 'Conflicts') {
  677.                 foreach my $elem (split(/, /, $2)) {
  678.                     $profile{'Conflicts'}->{$elem} = 1;
  679.                 }
  680.             } else {
  681.                 $profile{$fieldname} = $2;
  682.             }
  683.         } else {
  684.             chomp;
  685.             s/^\s+//;
  686.             $profile{$fieldname} .= "\n$_";
  687.             $profile{$fieldname} =~ s/^[\n\s]+//;
  688.         }
  689.     }
  690.     close(PROFILE);
  691.     if (!defined($profile{'Session-Interactive-Only'})) {
  692.             $profile{'Session-noninteractive-Type'} = $profile{'Session-Type'};
  693.             $profile{'Session-noninteractive'} = $profile{'Session'};
  694.             $profile{'Session-noninteractive-Initial'} = $profile{'Session-Initial'};
  695.     }
  696.     return %profile;
  697. }
  698.